perm filename SUBST1.NEW[1,JRA] blob sn#034720 filedate 1973-04-06 generic text, type T, neo UTF8
00100	(DE SUBST1(X Y Z)
00300	(PROG(VARNO VARL Z1 Z2)
00400	(SETQ VARNO 0)
00450	A(SETQ Z2(CNVT2(CAR Z)))(SUBST1A X Y Z2)
00500	(SETQ Z1(NCONC Z1(LIST Z2)))
00600	(SETQ Z(CDR Z))
00700	(COND(Z(GO A)))
00800	(RETURN Z1) ))
00900	
01000	(DE SUBST1A(X Y Z)
01100	(PROG NIL
01200	A(COND((ATOM(CAR Z))(COND((EQ (CAR Z) Y)(RPLACA Z X))))
01300	      ((CONST(CAR Z))(COND((EQUAL (CAR Z) Y)(RPLACA Z X))))
01400		((EQUAL(CAR Z) Y)(RPLACA Z X))
01500	(T(SUBST1A X Y (CDAR Z))))
01600	(SETQ Z(CDR Z))
01700	(COND(Z(GO A)))
01800	))